home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / BPAS9.ARJ / 3_3.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-07  |  10KB  |  289 lines
  1. {---------------------------------------------------------------------
  2.  PROGRAM: 3_3
  3.  
  4.  This program uses the same template feature to build looping procedures
  5.  quickly, filling in the NULL.PROC procedure template as needed, moving the
  6.  new procedure to it alphabetical place in the procedures, and placing
  7.  the procedure name in the MAIN PROGGRAM so that it is called in its
  8.  turn.
  9.  
  10.  See Tom Swan Chapter 4.  Divide and Conquer.
  11.  
  12.  Author:                    Mike Benedict
  13.  Date Started:              9/01/91
  14.  Latest Revision:           9/01/91
  15.  Version:                   Turbo Pascal 6.0
  16.  
  17.  -------------------------------------------------------------------}
  18.  
  19.  PROGRAM Lesson3_2;
  20.  
  21.  USES                                      { USES is a reserved word that  }
  22.    Crt;                                    { tells the compiler to use one }
  23.                                            { of the standard libraries or  }
  24.                                            { units listed in the Pascal    }
  25.                                            { Programmer's Guide.           }
  26.  
  27.  
  28.  VAR
  29.    Choice     :  Char;                     { Used in CASE Statements     }
  30.    UserQuits  :  Boolean;                  { Used to Quit Menu & Program }
  31.                                            { Note that all variables declared here
  32.                                              are GLOBAL and recognizable to the
  33.                                              program anywhere.           }
  34.  
  35.  
  36.  {------------------------------------}    { Anything between brackets  }
  37.  {            PROCEDURES              }    { is ignored at compile time }
  38.  {------------------------------------}    { and allows clear comments  }
  39.                                            { within source code.        }
  40.  
  41.  {-----------------------------}
  42.  {          INIT.PROC          }
  43.  {-----------------------------}
  44.  
  45.  PROCEDURE Init;
  46.  
  47.  BEGIN
  48.    TextBackground(Blue);                   { Procedures and functions that   }
  49.    TextColor(White);                       { are pre-defined by Borland's    }
  50.    ClrScr;                                 { Reference manual.  They are     }
  51.  END;                                      { called the Run-Time Library.    }
  52.  
  53.  
  54.  
  55.  {-----------------------------}
  56.  {         METRIC.PROC         }
  57.  {-----------------------------}
  58.  
  59.  PROCEDURE METRIC;
  60.                                            { See Tom Swan p.62 }
  61.                                            { Swan makes this a procedure. }
  62.  
  63.  VAR
  64.    Value       :  Real;
  65.    Selection   :  Integer;
  66.  
  67.    {---------Inches to Centimeters-----------------------} { Nested Procedures and Functions }
  68.  
  69.     PROCEDURE InchesToCentimeters;                         { Swan makes this a procedure, and we
  70.                                                              leave it a procedure. }
  71.  
  72.     CONST
  73.       CentPerInch  =  2.54;                                { Note that all constants and
  74.                                                              variables are LOCAL in this
  75.                                                              procedure.  }
  76.  
  77.     BEGIN
  78.       WriteLn( Value:1:2, ' inches = ',
  79.                Value * CentPerInch:1:2, ' centimeters'  );
  80.       ReadLn                                               { Swan doesn't use this }
  81.     END;     { InchesToCentimeters }
  82.  
  83.  
  84.    {---------Centimeters to Inches-----------------------}
  85.  
  86.    PROCEDURE CentimetersToInches;
  87.  
  88.    CONST
  89.      InchPerCent  =  0.397;
  90.  
  91.    BEGIN
  92.      WriteLn ( Value:1:2, ' centimeters = ',
  93.                Value * InchPerCent:1:2,  ' inches' );
  94.      ReadLn                                               { Swan doesn't use this }
  95.    END;      { CentimetersToInches }
  96.  
  97.  
  98.    {---------Feet to Meters------------------------------}
  99.  
  100.    PROCEDURE FeetToMeters;
  101.  
  102.    CONST
  103.      MetersPerFt  =  0.9144;
  104.  
  105.    BEGIN
  106.      WriteLn ( Value:1:2, ' Feet = ',
  107.                Value * MetersPerFt:1:2,  ' Meters' );
  108.      ReadLn                                               { Swan doesn't use this }
  109.    END;      { FeetToMeters }
  110.  
  111.  
  112.    {---------Meters to Feet------------------------------}
  113.  
  114.    PROCEDURE MetersToFeet;
  115.  
  116.    CONST
  117.      FtPerMeter  =  1.0936;
  118.  
  119.    BEGIN
  120.      WriteLn ( Value:1:2, ' Meters = ',
  121.                Value * FtPerMeter:1:2,  ' Feet' );
  122.      ReadLn                                               { Swan doesn't use this }
  123.    END;      { MetersToFeet }
  124.  
  125.  
  126.    {---------Miles to Kilometers-------------------------}
  127.  
  128.  
  129.    PROCEDURE MilesToKilometers;
  130.  
  131.    CONST
  132.      KmPerMile  =  1.6093;
  133.  
  134.    BEGIN
  135.      WriteLn ( Value:1:2, ' Miles = ',
  136.                Value * KmPerMile:1:2,  ' Kilometers' );
  137.      ReadLn                                               { Swan doesn't use this }
  138.    END;      { MilesToKilometers }
  139.  
  140.  
  141.    {---------Kilometers to Miles-------------------------}
  142.  
  143.    PROCEDURE KilometersToMiles;
  144.  
  145.    CONST
  146.      MilesPerKm = 0.62139;
  147.  
  148.    BEGIN
  149.      WriteLn ( Value:1:2, ' Kilometers = ',
  150.                Value * MilesPerKm:1:2,  ' Miles' );
  151.      ReadLn                                               { Swan doesn't use this }
  152.    END;      { KilometersToMiles }
  153.  
  154.    {-----------------------------------------------------}
  155.  
  156.  BEGIN
  157.    ClrScr;
  158.    WriteLn;
  159.    WriteLn;
  160.    Write    ( 'METRICS' );
  161.    WriteLn;
  162.    WriteLn;
  163.    Write    ( 'Value to Convert? ' );
  164.    ReadLn   (Value);
  165.    WriteLn  ( '1 - Inches to centimeters' );
  166.    WriteLn  ( '2 - Centimeters to inches' );
  167.    WriteLn  ( '3 - FeetToMeters         ' );
  168.    WriteLn  ( '4 - MetersToFeet         ' );
  169.    WriteLn  ( '5 - Miles to Kilometers  ' );
  170.    WriteLn  ( '6 - Kilometers to miles  ' );
  171.    WriteLn;
  172.    Write    ( 'Selection? ' ); ReadLn ( Selection );
  173.    WriteLn;
  174.    CASE Selection OF
  175.      1  :  InchesToCentimeters;
  176.      2  :  CentimetersToInches;
  177.      3  :  FeetToMeters;
  178.      4  :  MetersToFeet;
  179.      5  :  MilesToKilometers;
  180.      6  :  KilometersToMiles;
  181.  
  182.      ELSE WriteLn ( 'Selection Error' )
  183.    END      { CASE }
  184.  END;
  185.  
  186.  
  187.  {-----------------------------}
  188.  {       RANGECHK2.PROC        }
  189.  {-----------------------------}
  190.  
  191.  PROCEDURE RangeChk2;
  192.  
  193.  VAR
  194.    Age  :  0..100;
  195.  
  196.  BEGIN
  197.    ClrScr;
  198.    WriteLn;
  199.    WriteLn;
  200.    Write    ( 'How old are you?  ' );
  201. {$R-}                                      { Turn Range Checking Off }
  202.    ReadLn   ( Age );
  203.      IF (Age) > 100 THEN
  204.        WriteLn ('Age is too high.  See value below and then re-enter. ')
  205.      ELSE
  206.      IF (Age) < 0 THEN
  207.        WriteLn ('Age is too low.  See value below and then re-enter.  ')
  208.      ELSE
  209. {$R+}                                      { Turn Range Checking On  }
  210.        WriteLn;
  211.        WriteLn;
  212.        WriteLn  ( 'You are ', Age, ' years old.' );
  213.    ReadLn;
  214.  
  215.  END;
  216.  
  217.  
  218.  
  219.  {-----------------------------}
  220.  {         .PROC          }
  221.  {-----------------------------}
  222.  
  223.  PROCEDURE Null;
  224.  
  225.  BEGIN
  226.  END;
  227.  
  228.  
  229.  {------------------------------------}
  230.  {           MAIN PROGRAM             }
  231.  {------------------------------------}
  232.  
  233.   BEGIN
  234.     Init;                                   { Procedure Call }
  235.  
  236.     UserQuits := False;                     { Boolean Variable set to false }
  237.  
  238.     REPEAT                                  { Note that REPEAT UNTIL contains all the
  239.                                               WriteLn statements of the Menu, then the
  240.                                               ReadLn statement to capture the input,
  241.                                               before the CASE END block. }
  242.       ClrScr;
  243.       WriteLn;
  244.       WriteLn  ( '                    Welcome to Beginners Pascal');
  245.       WriteLn;
  246.       WriteLn  ( '                               MENU');
  247.       WriteLn;
  248.       WriteLn  ( '                       A.  Metric Conversion ' );
  249.       WriteLn  ( '                       B.  [Unused Menu Choice]' );
  250.       WriteLn  ( '                       C.  Range Check with Program Error Message ' );
  251.       WriteLn  ( '                       Q.  User Quits Menu'  );
  252.       WriteLn;
  253.       WriteLn;
  254.  
  255.       Write    ( 'Select a menu choice:  ' );
  256.       ReadLn   ( Choice );
  257.                                            { The CASE ___ OF statement uses the variable,
  258.                                              in this case "Choice" to capture the input,
  259.                                              then executes that procedure/function. }
  260.  
  261.                                            { Notice that after a choice, the loop returns
  262.                                              back to the Menu. }
  263.       CASE Choice OF
  264.         'a', 'A'    :  Metric;             { Choice A calls Procedure METRIC }
  265.         'b', 'B'    :  Null;               { Choice B calls Procedure RangeChk }
  266.         'c', 'C'    :  RangeChk2;          { Etc. }
  267.         'd', 'D'    :  Null;
  268.         'e', 'E'    :  Null;               { Choice calls Null.Proc until assigned }
  269.  
  270.  
  271.  
  272.         'q', 'Q'    :  UserQuits := True;  { Choice Q changes boolean value to False
  273.                                              and exits Repeat Until Loop and goes to
  274.                                              next line of Main Program code.  That is,
  275.                                              in this program it stops repeating the
  276.                                              menu and drops the user to a cursor.  When
  277.                                              you press <ENTER>, it exits the program.
  278.                                              Change the program to exit immediately.}
  279.  
  280.       END
  281.     UNTIL UserQuits;
  282.  
  283.     ReadLn;
  284.   END.                                     { ReadLn stops the program for user  }
  285.                                            { input.           This is a common  }
  286.                                            { way to get the program to stop and }
  287.                                            { show you the screen without pres-  }
  288.                                            { sing ALT-F5.                       }
  289.